The back and the front puzzle.

-a flat version of Rubik's Cube-

Ryohei Miyadera
Munetoshi Sakaguchi
Daisuke Minematsu
Ryota Kawazoe
Toshiro Miura
Kwansei Gakuin high school

You can read this article without the mathematics software Mathematica, but we carried out calculations and made figures in this articles using Mathematica.  The Mathematica program we used are printed in blue.

1. Introduction.

The back and front puzzle is a flat version of Rubik's Cube.  Although this is a very simple game compared to Rubik's　Cube, this game is very interesting in its own way.  This game was first introduced by Shigeo Takagi in Takagi [1]. In this game the front is colored with red and the back is colored with yellow.

Mathematica calculation for the above figure.  In fact to make a 3D figure is not a easy thing to do.

<< DiscreteMath`Combinatorica`

<< Geometry`Rotations`

Clear[z1, z2, z3, ppp2, uratwo2];
pointsofrectangle = {{{z1, z2, z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, 
            z3}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]], #[[2]], #[[3]] + 8} &, {{z1, z2, 
              z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, z3}, {z1, z2 + 1, 
              z3}}], {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1, z2 + 1, 
            z3 + 8}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]] + 2, #[[2]], #[[3]]} &, {{z1, z2, z3}, {z1, 
              z2, z3 + 8}, {z1, z2 + 1, z3 + 8}, {z1, z2 + 1, z3}}]}; 
    pointsofrectangle2 = {{{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, z2, 
            z3 + 8}, {z1 + 8, z2, z3}}};
pointsofrectangle3 = {Map[{#[[1]], #[[2]] + 
                  1, #[[3]]} &, {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, 
                z2, z3 + 8}, {z1 + 8, z2, z3}}]};
ppp2[z_, p_, q_, r_, s_, t_, u_] := 
      Block[{z1, z2, z3}, z1 = z[[1]]; z2 = z[[2]]; z3 = z[[3]]; 
        Join[Table[{SurfaceColor[Hue[s], Hue[s], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle[[n]]]]}, {n, 1, 4}], 
          Table[{SurfaceColor[Hue[t], Hue[t], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle2[[n]]]]}, {n, 1, 1}], 
          Table[{SurfaceColor[Hue[u], Hue[u], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle3[[n]]]]}, {n, 1, 1}]]]; 
    uratwo2[x_, x2_] := 
      Block[{de}, de[y_] := If[y == 1, 1/6, 1]; 
        Show[Graphics3D[{Text["front", {15, 8, 27}], 
              Text["back", {40, 11, 32}], 
              Join[
Map[
                  ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[5]]], 
                      de[1 - x[[5]]]] &, {{8, 0, 
                      8}}], 
Map[
                  ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[3]]], 
                      de[1 - x[[3]]]] &, {{8, 0, 
                      16}}], 
Map[
                  ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[1]]], 
                      de[1 - x[[1]]]] &, {{8, 0, 24}}], 
                Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[6]]], 
                      de[1 - x[[6]]]] &, {{16, 0, 
                      8}}], 
Map[
                  ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[4]]], 
                      de[1 - x[[4]]]] &, {{16, 0, 
                      16}}], 
Map[
                  ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[2]]], 
                      de[1 - x[[2]]]] &, {{16, 0, 24}}], 
                Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[5]]], 
                      de[1 - x2[[5]]]] &, {{32, -5, 
                      8}}], 
Map[
                  ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[3]]], 
                      de[1 - x2[[3]]]] &, {{32, -5, 
                      16}}], 
Map[
                  ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[1]]], 
                      de[1 - x2[[1]]]] &, {{32, -5, 24}}], 
                Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[6]]], 
                      de[1 - x2[[6]]]] &, {{40, -5, 
                      8}}], 
Map[
                  ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[4]]], 
                      de[1 - x2[[4]]]] &, {{40, -5, 
                      16}}], 
Map[
                  ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[2]]], 
                      de[1 - x2[[2]]]] &, {{40, -5, 
                      24}}]]}], 
Boxed -> False, 
          LightSources -> {{{1, 0, 20}, RGBColor[1, 0, 0]}, {{1, 1, 20}, 
                RGBColor[0, 1, 0]}, {{0, 1, 20}, 
                RGBColor[0, 0, 1]}}]];
uratwo2[{0, 0, 0, 0, 0, 0}, {1, 1, 1, 1, 1, 1}]

Shigeo Takagi treated the back and front puzzle as if it is a game you can pick up and rotate like Rubik's Cube.  Therefore two arrangements  in graph (1) can be seen identical, because you can get one from another just by picking up and rotate horizontally.  
    We use a different approach.  We fix our puzzle on a paper or screen.  Therefore we treat two arrangements in Graph (1) as two different ones, but our approach can lead to beautiful results that you will see later.  We studied the Back and Front Puzzle as a problem of graph theory, and found a very beautiful patterns in the puzzle.  Takagi studied the game with 3 rows and 3 columns, but first we are going to study the case of 3 rows and 2 columns.  Later we are going to study the case of 4 rows.  The difference of the number of rows and columns turned out to be very important factors in the puzzle.

⋯⋯Graph (1)

Mathematica calculation for the above figure.

Clear[z1, z2, z3, ppp2, uratwo];
pointsofrectangle = {{{z1, z2, z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, 
            z3}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]], #[[2]], #[[3]] + 8} &, {{z1, z2, 
              z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, z3}, {z1, z2 + 1, 
              z3}}], {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1, z2 + 1, 
            z3 + 8}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]] + 2, #[[2]], #[[3]]} &, {{z1, z2, z3}, {z1, 
              z2, z3 + 8}, {z1, z2 + 1, z3 + 8}, {z1, z2 + 1, z3}}]}; 
    pointsofrectangle2 = {{{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, z2, 
            z3 + 8}, {z1 + 8, z2, z3}}};
pointsofrectangle3 = {Map[{#[[1]], #[[2]] + 
                  1, #[[3]]} &, {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, 
                z2, z3 + 8}, {z1 + 8, z2, z3}}]};
ppp2[z_, p_, q_, r_, s_, t_, u_] := 
      Block[{z1, z2, z3}, z1 = z[[1]]; z2 = z[[2]]; z3 = z[[3]]; 
        Join[Table[{SurfaceColor[Hue[s], Hue[s], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle[[n]]]]}, {n, 1, 4}], 
          Table[{SurfaceColor[Hue[t], Hue[t], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle2[[n]]]]}, {n, 1, 1}], 
          Table[{SurfaceColor[Hue[u], Hue[u], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle3[[n]]]]}, {n, 1, 1}]]]; 
    uratwo[x_, x2_] := 
      Block[{de}, de[y_] := If[y == 1, 1/6, 1]; 
        Show[Graphics3D[
            Join[Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[5]]], 
                    de[1 - x[[5]]]] &, {{8, 0, 
                    8}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[3]]], 
                    de[1 - x[[3]]]] &, {{8, 0, 
                    16}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[1]]], 
                    de[1 - x[[1]]]] &, {{8, 0, 24}}], 
              Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[6]]], 
                    de[1 - x[[6]]]] &, {{16, 0, 
                    8}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[4]]], 
                    de[1 - x[[4]]]] &, {{16, 0, 
                    16}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[2]]], 
                    de[1 - x[[2]]]] &, {{16, 0, 24}}], 
              Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[5]]], 
                    de[1 - x2[[5]]]] &, {{32, -5, 
                    8}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[3]]], 
                    de[1 - x2[[3]]]] &, {{32, -5, 
                    16}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[1]]], 
                    de[1 - x2[[1]]]] &, {{32, -5, 24}}], 
              Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[6]]], 
                    de[1 - x2[[6]]]] &, {{40, -5, 
                    8}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[4]]], 
                    de[1 - x2[[4]]]] &, {{40, -5, 
                    16}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x2[[2]]], 
                    de[1 - x2[[2]]]] &, {{40, -5, 
                    24}}]]], 
Boxed -> False, 
          LightSources -> {{{1, 0, 20}, RGBColor[1, 0, 0]}, {{1, 1, 20}, 
                RGBColor[0, 1, 0]}, {{0, 1, 20}, 
                RGBColor[0, 0, 1]}}]];
uratwo[{1, 1, 1, 1, 0, 1}, {1, 0, 1, 1, 1, 1}]

2. The case of 2×3.

We only use five rotations for these arrangements.  We name these rotations R1,R2,R3,R4 and R5.

Mathematica calculation.

Clear[z1, z2, z3, ppp2];
pointsofrectangle = {{{z1, z2, z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, 
            z3}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]], #[[2]], #[[3]] + 8} &, {{z1, z2, 
              z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, z3}, {z1, z2 + 1, 
              z3}}], {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1, z2 + 1, 
            z3 + 8}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]] + 2, #[[2]], #[[3]]} &, {{z1, z2, z3}, {z1, 
              z2, z3 + 8}, {z1, z2 + 1, z3 + 8}, {z1, z2 + 1, z3}}]}; 
    pointsofrectangle2 = {{{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, z2, 
            z3 + 8}, {z1 + 8, z2, z3}}};
pointsofrectangle3 = {Map[{#[[1]], #[[2]] + 
                  1, #[[3]]} &, {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, 
                z2, z3 + 8}, {z1 + 8, z2, 
                z3}}]};
ppp2[z_, p_, q_, r_, s_, t_, u_] := 
      Block[{z1, z2, z3}, z1 = z[[1]]; z2 = z[[2]]; z3 = z[[3]]; 
        Join[Table[{SurfaceColor[Hue[s], Hue[s], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle[[n]]]]}, {n, 1, 4}], 
          Table[{SurfaceColor[Hue[t], Hue[t], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle2[[n]]]]}, {n, 1, 1}], 
          Table[{SurfaceColor[Hue[u], Hue[u], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle3[[n]]]]}, {n, 1, 1}]]]

x = {1, 1, 1, 1, 1, 1}; de[y_] := If[y == 1, 1/6, 1]; 
    Show[Graphics3D[{Text[R1, {-1, 20, 12}], 
          Text[R2, {-1.5, 11, 12}], Text[R3, {-3.5, 6, 9}], 
          Text[R4, {6, 27, 12}], Text[R5, {15, 27, 12}], 
          Join[Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[5]]], 
                  de[1 - x[[5]]]] &, {{8, 0, 8}}], 
Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[3]]], 
                  de[1 - x[[3]]]] &, {{8, 0, 
                  16}}], 
Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[1]]], 
                  de[1 - x[[1]]]] &, {{8, 0, 24}}], 
            Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[6]]], 
                  de[1 - x[[6]]]] &, {{16, 0, 
                  8}}], 
Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[4]]], 
                  de[1 - x[[4]]]] &, {{16, 0, 
                  16}}], 
Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[2]]], 
                  de[1 - x[[2]]]] &, {{16, 0, 
                  24}}]]}], 
Boxed -> False, 
      LightSources -> {{{1, 0, 20}, RGBColor[1, 0, 0]}, {{1, 1, 20}, 
            RGBColor[0, 1, 0]}, {{0, 1, 20}, RGBColor[0, 0, 1]}}]

Example 1.   The following pictures  show you how these rotation occur.

How Mathematica imports these graphics.

Directory[]

SetDirectory["picture"]

FileNames["R*"]

Import["R123.gif"]

Show[%]

Example 2.   (1)   If you start with  and use R1, then you get .  See the picture below.

(2)  After that if  you  use R4, then you get. See the picture below.

Mathematica calculation.

Clear[z1, z2, z3, pp2];
pointsofrectangle = {{{z1, z2, z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, 
            z3}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]], #[[2]], #[[3]] + 8} &, {{z1, z2, 
              z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, z3}, {z1, z2 + 1, 
              z3}}], {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1, z2 + 1, 
            z3 + 8}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]] + 2, #[[2]], #[[3]]} &, {{z1, z2, z3}, {z1, 
              z2, z3 + 8}, {z1, z2 + 1, z3 + 8}, {z1, z2 + 1, z3}}]}; 
    pointsofrectangle2 = {{{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, z2, 
            z3 + 8}, {z1 + 8, z2, z3}}};
pointsofrectangle3 = {Map[{#[[1]], #[[2]] + 
                  1, #[[3]]} &, {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, 
                z2, z3 + 8}, {z1 + 8, z2, 
                z3}}]};
ppp2[z_, p_, q_, r_, s_, t_, u_] := 
      Block[{z1, z2, z3}, z1 = z[[1]]; z2 = z[[2]]; z3 = z[[3]]; 
        Join[Table[{SurfaceColor[Hue[s], Hue[s], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle[[n]]]]}, {n, 1, 4}], 
          Table[{SurfaceColor[Hue[t], Hue[t], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle2[[n]]]]}, {n, 1, 1}], 
          Table[{SurfaceColor[Hue[u], Hue[u], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle3[[n]]]]}, {n, 1, 1}]]]

ura[x_] := 
      Block[{de}, de[y_] := If[y == 1, 1/6, 1]; 
        Show[Graphics3D[
            Join[Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[5]]], 
                    de[1 - x[[5]]]] &, {{8, 0, 
                    8}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[3]]], 
                    de[1 - x[[3]]]] &, {{8, 0, 
                    16}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[1]]], 
                    de[1 - x[[1]]]] &, {{8, 0, 24}}], 
              Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[6]]], 
                    de[1 - x[[6]]]] &, {{16, 0, 
                    8}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[4]]], 
                    de[1 - x[[4]]]] &, {{16, 0, 
                    16}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[2]]], 
                    de[1 - x[[2]]]] &, {{16, 0, 
                    24}}]]], 
Boxed -> False, 
          LightSources -> {{{1, 0, 20}, RGBColor[1, 0, 0]}, {{1, 1, 20}, 
                RGBColor[0, 1, 0]}, {{0, 1, 20}, 
                RGBColor[0, 0, 1]}}]]

ura[{1, 1, 1, 1, 0, 1}]

Mathematica calculation to divide arangemant into mutually disjoint classes.  The following calculation shows that all the arrangement can be diviede into 5 subclasses

Clear[g, x];
g[1][
          x_] := {{1 - x[[1, 2]], 1 - x[[1, 1]]}, {x[[2, 1]], 
            x[[2, 2]]}, {x[[3, 1]], x[[3, 2]]}};
g[2][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {1 - x[[2, 2]], 
            1 - x[[2, 1]]}, {x[[3, 1]], x[[3, 2]]}};
g[3][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[3, 2]], 
            1 - x[[3, 1]]}};
g[4][
          x_] := {{1 - x[[3, 1]], x[[1, 2]]}, {1 - x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[1, 1]], x[[3, 2]]}};
g[5][
          x_] := {{x[[1, 1]], 1 - x[[3, 2]]}, {x[[2, 1]], 
            1 - x[[2, 2]]}, {x[[3, 1]], 
            1 - x[[1, 2]]}};

findvertex[x_] := 
      Block[{a = x, b, s, t1, t2}, t1 = 1; t2 = 2; s = {a}; 
        While[t2 > t1, t1 = Length[s]; 
          b = Flatten[
              Table[g[n][s[[m]]], {m, 1, Length[s]}, {n, 1, 5}], 1]; 
          s = Union[s, b]; t2 = Length[s]]; s]

Clear[s, v];
v=Flatten[Table[(({{x1, x2}, {x3, x4}, {x5, x6}})),{x1, 0, 1},{x2, 0, 1},{x3, 0, 1},{x4, 0, 1},{x5, 0, 1},{x6, 0, 1}],5];
k = Length[v]; t = 1; 
    While[k > 0, a = v[[1]]; s[t] = findvertex[a]; Print[t]; Print[s[t]]; 
      v = Complement[v, s[t]]; k = Length[v]; t = t + 1]

Example 3.  If you start with  , how many arrangements are there that you can get by using these five rotations.  Here you can use rotations as many times as you want.

Answer.  You can get the arrangements in Graph (2).

⋯⋯Graph (2)

Mathematica calculation for the above table.

<< DiscreteMath`Combinatorica`

showfigure[s_] := 
      Block[{b}, b = Flatten[s]; 
        Show[Graphics[
            Evaluate[
Table[
                Table[{Hue[Part[b, (y + 2  x)]/6], 
                    Rectangle[{y - 0.45, -x - 0.45}, {y + 0.45, -x + 
                          0.45}]}, 
{y, 1, 2}], {x, 0, 
                  2}]]], AspectRatio -> Automatic, 
          Background -> Black]]

showfigure[{{1, 1}, {1, 1}, {0, 1}}]

showfigure[{{1, 0}, {1, 1}, {1, 1}}]

These function g[k][x] returns the arrangement you get after applying rotation Rk to the arrangement x.

Clear[g, x];
g[1][
          x_] := {{1 - x[[1, 2]], 1 - x[[1, 1]]}, {x[[2, 1]], 
            x[[2, 2]]}, {x[[3, 1]], x[[3, 2]]}};
g[2][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {1 - x[[2, 2]], 
            1 - x[[2, 1]]}, {x[[3, 1]], x[[3, 2]]}};
g[3][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[3, 2]], 
            1 - x[[3, 1]]}};
g[4][
          x_] := {{1 - x[[3, 1]], x[[1, 2]]}, {1 - x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[1, 1]], x[[3, 2]]}};
g[5][
          x_] := {{x[[1, 1]], 1 - x[[3, 2]]}, {x[[2, 1]], 
            1 - x[[2, 2]]}, {x[[3, 1]], 
            1 - x[[1, 2]]}};

This function firststep[x] returns all the arrangement you get after applying one of 5 rotations R1, R2, R3, R4 and R5  to the arrangement x once.

firststep[x_] := Table[g[n][x], {n, 1, 5}];

Example.  From {{1,1},{1,1},{0,1}} you get the following 5 arrangements.

firststep[(({{1, 1}, {1, 1}, {0, 1}}))]

This function findvertex[x] returns all the arrangement you get after applying one of 5 rotations R1, R2, R3, R4 and R5  to the arrangement x as many times as you want.  In fact the number is finite, because of the structure of the puzzle.

findvertex[x_] := 
      Block[{a = x, b, s, t1, t2}, t1 = 1; t2 = 2; s = {a}; 
        While[t2 > t1, t1 = Length[s]; 
          b = Flatten[
              Table[g[n][s[[m]]], {m, 1, Length[s]}, {n, 1, 5}], 1]; 
          s = Union[s, b]; t2 = Length[s]]; s]

From {{1,1},{1,1},{0,1}} you get the following 16 arrangements.

findvertex[{{1, 1}, {1, 1}, {0, 1}}]

% // Length

The order of the arrangements in the above table was made by mathematics software Mathematica, but we changed the order to suit our purpose.

saka1 = {{{0, 0}, {1, 0}, {0, 1}}, {{1, 1}, {1, 0}, {0, 1}}, {{1, 
              0}, {0, 1}, {1, 1}}, {{1, 0}, {0, 1}, {0, 0}}, {{1, 0}, {0, 
              0}, {1, 1}}, {{0, 0}, {1, 1}, {0, 1}}, {{1, 0}, {1, 1}, {0, 
              0}}, {{1, 1}, {0, 0}, {0, 1}}, {{1, 0}, {0, 0}, {0, 0}}, {{1, 
              1}, {1, 1}, {0, 1}}, {{1, 0}, {1, 1}, {1, 1}}, {{0, 0}, {0, 
              0}, {0, 1}}, {{1, 1}, {0, 1}, {0, 1}}, {{0, 0}, {0, 1}, {0, 
              1}}, {{1, 0}, {1, 0}, {0, 0}}, {{1, 0}, {1, 0}, {1, 
              1}}};

Show[
      Graphics[Evaluate[
          Table[Table[{Text[k + 4 (h - 1), {1.5 + 3  h, 0.7 - 4  k}], 
                Table[Table[{Hue[
                        Part[Flatten[
                              saka1[[k + 4 (h - 1)]]], (y + 
                                2  x)]/6], 
                      Rectangle[{y + 3  h - 0.45, -x - 4  k - 0.45}, {y + 
                            3  h + 0.45, -x - 4  k + 0.45}]}, {y, 1, 
                      2}], {x, 0, 2}]}, {k, 1, 4}], {h, 1, 4}]]], 
      AspectRatio -> Automatic, Background -> Black]

Example 4.  It is a good way to use the theory of graph to study the Back and Front Puzzle.  We denote each arrangement by a red vertex.  If you can get an arrangement from another arrangement using only one rotation, then we connect the two vertexes corresponding to these two arrangements with a blue line.
    For example please look at the vertex 5 and 9.  It is easy to see that by rotation R3 we get arrangement 9 from arrangement 5.  Therefore we connect them with a blue line.  In the similar way we can connect other vertexes, and get Graph (3).
    When we made Graph (3), we chose vertexes with fewer lines and located them on the first column and the last column.  We located vertexes with more lines in the middle of Graph (3).

⋯⋯Graph (3)

Mathematica calculation to make the above graph.

Clear[x];

saka1 = {{{0, 0}, {1, 0}, {0, 1}}, {{1, 1}, {1, 0}, {0, 1}}, {{1, 
              0}, {0, 1}, {1, 1}}, {{1, 0}, {0, 1}, {0, 0}}, {{1, 0}, {0, 
              0}, {1, 1}}, {{0, 0}, {1, 1}, {0, 1}}, {{1, 0}, {1, 1}, {0, 
              0}}, {{1, 1}, {0, 0}, {0, 1}}, {{1, 0}, {0, 0}, {0, 0}}, {{1, 
              1}, {1, 1}, {0, 1}}, {{1, 0}, {1, 1}, {1, 1}}, {{0, 0}, {0, 
              0}, {0, 1}}, {{1, 1}, {0, 1}, {0, 1}}, {{0, 0}, {0, 1}, {0, 
              1}}, {{1, 0}, {1, 0}, {0, 0}}, {{1, 0}, {1, 0}, {1, 
              1}}};

numb1[x_] := Position[saka1, x][[1, 1]];

By using two functions firststep and numb we can make the list of lines that connect vertexes.

dd1 = 
      Flatten[Table[
          Map[{{n, numb1[#]}} &, firststep[saka1[[n]]]], {n, 1, 
            Length[saka1]}], 1]

Clear[f]

f[x_] := {{Min[x[[1, 1]], x[[1, 2]]], 
          Max[x[[1, 1]], x[[1, 2]]]}}

dd2 = 
      Select[Union[Map[f, dd1]], #[[1, 1]] < #[[1, 2]] &]

<< DiscreteMath`Combinatorica`

Clear[G2];

dd2 = {{{1, 2}}, {{1, 5}}, {{1, 6}}, {{2, 7}}, {{2, 8}}, {{3, 
              4}}, {{3, 5}}, {{3, 6}}, {{4, 7}}, {{4, 8}}, {{5, 9}}, {{5, 
              11}}, {{6, 10}}, {{6, 12}}, {{7, 9}}, {{7, 11}}, {{8, 
              10}}, {{8, 12}}, {{9, 13}}, {{9, 15}}, {{10, 13}}, {{10, 
              15}}, {{11, 14}}, {{11, 16}}, {{12, 14}}, {{12, 16}}, {{13, 
              14}}, {{15, 16}}};

G2 = 
        Graph[dd2, {{{10, 15}}, {{10, 10}}, {{10, 5}}, {{10, 0}}, {{20, 
                15}}, {{20, 10}}, {{20, 5}}, {{20, 0}}, {{30, 15}}, {{30, 
                10}}, {{30, 5}}, {{30, 0}}, {{40, 15}}, {{40, 10}}, {{40, 
                5}}, {{40, 0}}}];

ShowGraph[
        SetGraphOptions[
          G2, {{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 
              VertexColor -> Red}}, EdgeColor -> Blue, 
          Background -> Green], VertexNumber -> True];

A Hamiltonian path is a path between two vertexes of a graph that visits each vertex exactly  once.  Can you find a Hamiltonian path of the above graph?

Answer.  A Hamiltonina path is {1,2,7,4,3,5,9,13,14,11,16,15,10,8,12,6}.  It is not difficult to check this using the above graph.  
    Perhaps it is easier to see the Hamiltonian path in the list of pictures.  Please see Graph (4).  The rotations you are going to use are R1,R5,R4,R3,R5,R3,R5,R1,R4,R5,R3,R5,R2,R1 and R2.

⋯⋯Graph (4)

Mathematica calculation to find a Hamiltonian path and related calculations.

We are going to find a Hamiltonian path.

HamiltonianPath[g_Graph]  :=  HamiltonianPath[g,  One]
\(HamiltonianPath[g_Graph, \ 
        One]\  := \ 
\ \ \ \ \ \ \ \ Module[{c\  = \ HamiltonianCycle[g], \ 
          nonEdges, \ p, \ q}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[
          c\  != \ {}, \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Drop[
            c, \ \(-1\)], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ nonEdges\  = \ Complement[Flatten[
                Table[{i, \ j}, \ {i, \ V[g] - 1}, \ {j, \ i + 1, \ V[g]}], 
                1], \ Edges[g]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Do[
            h\  = \ AddEdges[g, \ 
                nonEdges[\([i]\)]]; \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[\((\((BiconnectedQ[
                      h])\)\  && \ \((\((c\  = \ 
                          HamiltonianCycle[
                            h])\)\  != \ {})\))\), 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ p\  = \ \(Position[c\  = \ Drop[c, \(-1\)], \ 
                    nonEdges[\([i, \ 1]\)]]\)[\([1, \ 
                    1]\)]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ c\  = \ RotateLeft[c, \ 
                  p - 1]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[nonEdges[\([i, \ 2]\)]\  == \ c[\([2]\)], \ 
                c\  = \ RotateLeft[c, \ 
                    1]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Break[]
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ {i, \ 
              Length[nonEdges]}
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ c
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]
\ \ \ \ \ \ \ \ ]\)

pa = HamiltonianPath[G2]

In the above we get the Hamiltonian path as a list of numbers.  Next we are going to find the list of arrangements and their pictures.

saka1 = {{{0, 0}, {1, 0}, {0, 1}}, {{1, 1}, {1, 0}, {0, 1}}, {{1, 
              0}, {0, 1}, {1, 1}}, {{1, 0}, {0, 1}, {0, 0}}, {{1, 0}, {0, 
              0}, {1, 1}}, {{0, 0}, {1, 1}, {0, 1}}, {{1, 0}, {1, 1}, {0, 
              0}}, {{1, 1}, {0, 0}, {0, 1}}, {{1, 0}, {0, 0}, {0, 0}}, {{1, 
              1}, {1, 1}, {0, 1}}, {{1, 0}, {1, 1}, {1, 1}}, {{0, 0}, {0, 
              0}, {0, 1}}, {{1, 1}, {0, 1}, {0, 1}}, {{0, 0}, {0, 1}, {0, 
              1}}, {{1, 0}, {1, 0}, {0, 0}}, {{1, 0}, {1, 0}, {1, 
              1}}};

hami = {1, 2, 7, 4, 3, 5, 9, 13, 14, 11, 16, 15, 10, 8, 12, 
        6}

This is the list of arrangements.

hamar = 
      Table[saka1[[hami[[n]]]], {n, 1, Length[hami]}]

The list of pictures of arrangements that constitute the Himiltonian path.

Show[
      Graphics[Evaluate[{Table[
              Table[Table[{Hue[
                      Part[Flatten[hamar[[k]]], (y + 2  x)]/6], 
                    Rectangle[{y - 0.45 + 3 (k - 1.5), -x - 
                          0.45}, {y + 0.45 + 3 (k - 1.5), -x + 
                          0.45}]}, {y, 1, 2}], {x, 0, 2}], {k, 1, 
                Length[hamar]}]}]], AspectRatio -> Automatic, 
      Background -> Black]

Next we are going to find which rotations you need to make a Hamiltonian path.

Clear[g, x];
g[1][
          x_] := {{1 - x[[1, 2]], 1 - x[[1, 1]]}, {x[[2, 1]], 
            x[[2, 2]]}, {x[[3, 1]], x[[3, 2]]}};
g[2][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {1 - x[[2, 2]], 
            1 - x[[2, 1]]}, {x[[3, 1]], x[[3, 2]]}};
g[3][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[3, 2]], 
            1 - x[[3, 1]]}};
g[4][
          x_] := {{1 - x[[3, 1]], x[[1, 2]]}, {1 - x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[1, 1]], x[[3, 2]]}};
g[5][
          x_] := {{x[[1, 1]], 1 - x[[3, 2]]}, {x[[2, 1]], 
            1 - x[[2, 2]]}, {x[[3, 1]], 
            1 - x[[1, 2]]}};

The function findr[x,y] returns the number of rotation that we need to get y from x.  If there is proper rotation, the function returns "no".

findr[x_, y_] := 
        Block[{k}, k = 1; While[y ≠ g[k][x], k = k + 1]; 
          If[k < 6, k, Print["no"]]];

Table[
      findr[hamar[[k]], hamar[[k + 1]]], {k, 1, 
        Length[hamar] - 1}]

Problem 1.  If you start with   , how many arrangements are there that you can get by using the five rotations.  You can use rotations as many times as you want.

Mathematica calculation for the above graphics.

Clear[z1, z2, z3, pp2];
pointsofrectangle = {{{z1, z2, z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, 
            z3}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]], #[[2]], #[[3]] + 8} &, {{z1, z2, 
              z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, z3}, {z1, z2 + 1, 
              z3}}], {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1, z2 + 1, 
            z3 + 8}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]] + 2, #[[2]], #[[3]]} &, {{z1, z2, z3}, {z1, 
              z2, z3 + 8}, {z1, z2 + 1, z3 + 8}, {z1, z2 + 1, z3}}]}; 
    pointsofrectangle2 = {{{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, z2, 
            z3 + 8}, {z1 + 8, z2, z3}}};
pointsofrectangle3 = {Map[{#[[1]], #[[2]] + 
                  1, #[[3]]} &, {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, 
                z2, z3 + 8}, {z1 + 8, z2, 
                z3}}]};
ppp2[z_, p_, q_, r_, s_, t_, u_] := 
      Block[{z1, z2, z3}, z1 = z[[1]]; z2 = z[[2]]; z3 = z[[3]]; 
        Join[Table[{SurfaceColor[Hue[s], Hue[s], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle[[n]]]]}, {n, 1, 4}], 
          Table[{SurfaceColor[Hue[t], Hue[t], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle2[[n]]]]}, {n, 1, 1}], 
          Table[{SurfaceColor[Hue[u], Hue[u], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle3[[n]]]]}, {n, 1, 1}]]]

ura2[x_] := 
      Block[{de}, de[y_] := If[y == 1, 1/6, 1]; 
        Show[Graphics3D[
            Join[Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[1]]], 
                    de[1 - x[[1]]]] &, {{8, 0, 
                    8}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[2]]], 
                    de[1 - x[[2]]]] &, {{8, 0, 
                    16}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[3]]], 
                    de[1 - x[[3]]]] &, {{8, 0, 
                    24}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[4]]], 
                    de[1 - x[[4]]]] &, {{8, 0, 32}}], 
              Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[5]]], 
                    de[1 - x[[5]]]] &, {{16, 0, 
                    8}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[6]]], 
                    de[1 - x[[6]]]] &, {{16, 0, 
                    16}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[7]]], 
                    de[1 - x[[7]]]] &, {{16, 0, 24}}], 
              Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[8]]], 
                    de[1 - x[[8]]]] &, {{16, 0, 
                    32}}]]], 
Boxed -> False, 
          LightSources -> {{{1, 0, 20}, RGBColor[1, 0, 0]}, {{1, 1, 20}, 
                RGBColor[0, 1, 0]}, {{0, 1, 20}, 
                RGBColor[0, 0, 1]}}]]

ura2[{1, 1, 1, 1, 1, 1, 1, 1}]

Answer to problem 1.

If you start with   , then there are 24 arrangement that you can get by using the five rotations.  It is not difficult to check the answer once you get one.  The order of arrangement in the following table looks a little bit strange, but this order is best fit to the structure of the Back and Front Puzzle.  You will see this fact later.

⋯⋯Graph (5)

Mathematica calculation for the above table.

These function g[k][x] returns the arrangement you get after applying rotation Rk to the arrangement x.

Clear[g, x];
g[1][
          x_] := {{1 - x[[1, 2]], 1 - x[[1, 1]]}, {x[[2, 1]], 
            x[[2, 2]]}, {x[[3, 1]], x[[3, 2]]}};
g[2][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {1 - x[[2, 2]], 
            1 - x[[2, 1]]}, {x[[3, 1]], x[[3, 2]]}};
g[3][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[3, 2]], 
            1 - x[[3, 1]]}};
g[4][
          x_] := {{1 - x[[3, 1]], x[[1, 2]]}, {1 - x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[1, 1]], x[[3, 2]]}};
g[5][
          x_] := {{x[[1, 1]], 1 - x[[3, 2]]}, {x[[2, 1]], 
            1 - x[[2, 2]]}, {x[[3, 1]], 
            1 - x[[1, 2]]}};

This function firststep[x] returns all the arrangement you get after applying one of 5 rotations R1, R2, R3, R4 and R5  to the arrangement x once.

firststep[x_] := Table[g[n][x], {n, 1, 5}];

Example.  From {{1,1},{1,1},{1,1}} you get the following 5 arrangements.

firststep[(({{1, 1}, {1, 1}, {1, 1}}))]

This function findvertex[x] returns all the arrangement you get after applying one of 5 rotations R1, R2, R3, R4 and R5  to the arrangement x as many times as you want.  In fact the number is finite, because of the structure of the puzzle.

findvertex[x_] := 
      Block[{a = x, b, s, t1, t2}, t1 = 1; t2 = 2; s = {a}; 
        While[t2 > t1, t1 = Length[s]; 
          b = Flatten[
              Table[g[n][s[[m]]], {m, 1, Length[s]}, {n, 1, 5}], 1]; 
          s = Union[s, b]; t2 = Length[s]]; s]

From {{1,1},{1,1},{1,1}} you get the following 24 arrangements.

findvertex[{{1, 1}, {1, 1}, {1, 1}}]

The order of the arrangements in the above table was made by mathematics software Mathematica, but we changed the order to suit our purpose.

saka = {{{0, 1}, {0, 1}, {0, 1}}, {{0, 1}, {1, 0}, {0, 1}}, {{1, 
              0}, {0, 1}, {1, 0}}, {{1, 0}, {1, 0}, {1, 0}}, {{1, 1}, {1, 
              1}, {1, 1}}, {{1, 1}, {0, 0}, {1, 1}}, {{0, 0}, {1, 1}, {0, 
              0}}, {{0, 0}, {0, 0}, {0, 0}}, {{0, 0}, {1, 1}, {1, 1}}, {{0, 
              0}, {0, 0}, {1, 1}}, {{1, 1}, {1, 1}, {0, 0}}, {{1, 1}, {0, 
              0}, {0, 0}}, {{0, 0}, {0, 1}, {1, 1}}, {{0, 0}, {1, 0}, {1, 
              1}}, {{1, 1}, {0, 1}, {0, 0}}, {{1, 1}, {1, 0}, {0, 0}}, {{1, 
              1}, {0, 1}, {1, 1}}, {{1, 1}, {1, 0}, {1, 1}}, {{0, 0}, {0, 
              1}, {0, 0}}, {{0, 0}, {1, 0}, {0, 0}}, {{0, 1}, {1, 1}, {0, 
              1}}, {{0, 1}, {0, 0}, {0, 1}}, {{1, 0}, {1, 1}, {1, 0}}, {{1, 
              0}, {0, 0}, {1, 0}}};

Show[
      Graphics[Evaluate[
          Table[Table[{Text[k + 4 (h - 1), {1.5 + 3  h, 0.7 - 4  k}], 
                Table[Table[{Hue[
                        Part[Flatten[
                              saka[[k + 4 (h - 1)]]], (y + 2  x)]/
                          6], Rectangle[{y + 3  h - 0.45, -x - 4  k - 
                            0.45}, {y + 3  h + 0.45, -x - 4  k + 
                            0.45}]}, {y, 1, 2}], {x, 0, 2}]}, {k, 1, 4}], {h, 
              1, 6}]]], AspectRatio -> Automatic, 
      Background -> Black]

Problem 2.  Can you make a graph using Graph (5)?  Can you find a Hamiltonian path?

Answer to problem 2.

⋯⋯Graph (6)

One Hamiltonian path is {2,6,3,7,9,10,13,17,21,22,18,14,20,24,23,19,15,11,16,12,8,4,5,1}.  It is not difficult to check this solution.

Mathematica calculation for the answer.

g[1][
          x_] := {{1 - x[[1, 2]], 1 - x[[1, 1]]}, {x[[2, 1]], 
            x[[2, 2]]}, {x[[3, 1]], x[[3, 2]]}};
g[2][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {1 - x[[2, 2]], 
            1 - x[[2, 1]]}, {x[[3, 1]], x[[3, 2]]}};
g[3][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[3, 2]], 
            1 - x[[3, 1]]}};
g[4][
          x_] := {{1 - x[[3, 1]], x[[1, 2]]}, {1 - x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[1, 1]], x[[3, 2]]}};
g[5][
          x_] := {{x[[1, 1]], 1 - x[[3, 2]]}, {x[[2, 1]], 
            1 - x[[2, 2]]}, {x[[3, 1]], 
            1 - x[[1, 2]]}};

saka = {{{0, 1}, {0, 1}, {0, 1}}, {{0, 1}, {1, 0}, {0, 1}}, {{1, 
              0}, {0, 1}, {1, 0}}, {{1, 0}, {1, 0}, {1, 0}}, {{1, 1}, {1, 
              1}, {1, 1}}, {{1, 1}, {0, 0}, {1, 1}}, {{0, 0}, {1, 1}, {0, 
              0}}, {{0, 0}, {0, 0}, {0, 0}}, {{0, 0}, {1, 1}, {1, 1}}, {{0, 
              0}, {0, 0}, {1, 1}}, {{1, 1}, {1, 1}, {0, 0}}, {{1, 1}, {0, 
              0}, {0, 0}}, {{0, 0}, {0, 1}, {1, 1}}, {{0, 0}, {1, 0}, {1, 
              1}}, {{1, 1}, {0, 1}, {0, 0}}, {{1, 1}, {1, 0}, {0, 0}}, {{1, 
              1}, {0, 1}, {1, 1}}, {{1, 1}, {1, 0}, {1, 1}}, {{0, 0}, {0, 
              1}, {0, 0}}, {{0, 0}, {1, 0}, {0, 0}}, {{0, 1}, {1, 1}, {0, 
              1}}, {{0, 1}, {0, 0}, {0, 1}}, {{1, 0}, {1, 1}, {1, 0}}, {{1, 
              0}, {0, 0}, {1, 0}}};

firststep[x_] := Table[g[n][x], {n, 1, 5}];

The function mumb[x] returns the position of the arrangement in the list sakaguchi.

numb[x_] := Position[saka, x][[1, 1]];

numb[{{0, 0}, {1, 1}, {1, 1}}]

By using two functions firststep and numb we can make the list of lines that connect vertexes.

dd = 
      Flatten[Table[
          Map[{{n, numb[#]}} &, firststep[saka[[n]]]], {n, 
            1.  Length[saka]}], 1]

f[x_] := {{Min[x[[1, 1]], x[[1, 2]]], 
          Max[x[[1, 1]], x[[1, 2]]]}}

dd2 = 
      Select[Union[
          Map[f, dd]], #[[1, 1]] ≤ #[[1, 2]] &]

Length[dd2]

<< DiscreteMath`Combinatorica`

G1 = 
        Graph[dd2, {{{10, 15}}, {{10, 10}}, {{10, 5}}, {{10, 0}}, {{20, 
                15}}, {{20, 10}}, {{20, 5}}, {{20, 0}}, {{30, 15}}, {{30, 
                10}}, {{30, 5}}, {{30, 0}}, {{40, 15}}, {{40, 10}}, {{40, 
                5}}, {{40, 0}}, {{50, 15}}, {{50, 10}}, {{50, 5}}, {{50, 
                0}}, {{60, 15}}, {{60, 10}}, {{60, 5}}, {{60, 
                0}}}];

ShowGraph[
        SetGraphOptions[
          G1, {{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 
              18, 19, 20, 21, 22, 23, 24, VertexColor -> Red}}, 
          EdgeColor -> Blue, Background -> Green], 
        VertexNumber -> True];

If you do not need loops, you can omit them.

dd3 = 
      Select[Union[Map[f, dd]], #[[1, 1]] < #[[1, 2]] &]

Length[dd3]

dd3 = {{{1, 5}}, {{1, 8}}, {{2, 6}}, {{2, 7}}, {{3, 6}}, {{3, 
              7}}, {{4, 5}}, {{4, 8}}, {{5, 6}}, {{5, 9}}, {{5, 11}}, {{6, 
              10}}, {{6, 12}}, {{7, 8}}, {{7, 9}}, {{7, 11}}, {{8, 10}}, {{8, 
              12}}, {{9, 10}}, {{9, 13}}, {{9, 14}}, {{10, 13}}, {{10, 
              14}}, {{11, 12}}, {{11, 15}}, {{11, 16}}, {{12, 15}}, {{12, 
              16}}, {{13, 17}}, {{13, 19}}, {{14, 18}}, {{14, 20}}, {{15, 
              17}}, {{15, 19}}, {{16, 18}}, {{16, 20}}, {{17, 21}}, {{17, 
              24}}, {{18, 22}}, {{18, 23}}, {{19, 22}}, {{19, 23}}, {{20, 
              21}}, {{20, 24}}, {{21, 22}}, {{23, 24}}};

G2 = 
        Graph[dd3, {{{10, 15}}, {{10, 10}}, {{10, 5}}, {{10, 0}}, {{20, 
                15}}, {{20, 10}}, {{20, 5}}, {{20, 0}}, {{30, 15}}, {{30, 
                10}}, {{30, 5}}, {{30, 0}}, {{40, 15}}, {{40, 10}}, {{40, 
                5}}, {{40, 0}}, {{50, 15}}, {{50, 10}}, {{50, 5}}, {{50, 
                0}}, {{60, 15}}, {{60, 10}}, {{60, 5}}, {{60, 
                0}}}];

ShowGraph[
        SetGraphOptions[
          G2, {{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 
              18, 19, 20, 21, 22, 23, 24, VertexColor -> Red}}, 
          EdgeColor -> Blue, Background -> Green], 
        VertexNumber -> True];

HamiltonianPath[g_Graph]  :=  HamiltonianPath[g,  One]
\(HamiltonianPath[g_Graph, \ 
        One]\  := \ 
\ \ \ \ \ \ \ \ Module[{c\  = \ HamiltonianCycle[g], \ 
          nonEdges, \ p, \ q}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[
          c\  != \ {}, \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Drop[
            c, \ \(-1\)], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ nonEdges\  = \ Complement[Flatten[
                Table[{i, \ j}, \ {i, \ V[g] - 1}, \ {j, \ i + 1, \ V[g]}], 
                1], \ Edges[g]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Do[
            h\  = \ AddEdges[g, \ 
                nonEdges[\([i]\)]]; \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[\((\((BiconnectedQ[
                      h])\)\  && \ \((\((c\  = \ 
                          HamiltonianCycle[
                            h])\)\  != \ {})\))\), 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ p\  = \ \(Position[c\  = \ Drop[c, \(-1\)], \ 
                    nonEdges[\([i, \ 1]\)]]\)[\([1, \ 
                    1]\)]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ c\  = \ RotateLeft[c, \ 
                  p - 1]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[nonEdges[\([i, \ 2]\)]\  == \ c[\([2]\)], \ 
                c\  = \ RotateLeft[c, \ 
                    1]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Break[]
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ {i, \ 
              Length[nonEdges]}
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ c
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]
\ \ \ \ \ \ \ \ ]\)

Timing[HamiltonianPath[G2]]

3. The case of 2×4.

In the previous section we studied the puzzle with 2 columns and 3 rows.  In this section we are going to study the puzzle with 2 columns and 4 rows.
    This time we have 6 rotations.

Mathematica calculation for the above graphics.

Clear[z1, z2, z3, ppp2];
pointsofrectangle = {{{z1, z2, z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, 
            z3}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]], #[[2]], #[[3]] + 8} &, {{z1, z2, 
              z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, z3}, {z1, z2 + 1, 
              z3}}], {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1, z2 + 1, 
            z3 + 8}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]] + 2, #[[2]], #[[3]]} &, {{z1, z2, z3}, {z1, 
              z2, z3 + 8}, {z1, z2 + 1, z3 + 8}, {z1, z2 + 1, z3}}]}; 
    pointsofrectangle2 = {{{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, z2, 
            z3 + 8}, {z1 + 8, z2, z3}}};
pointsofrectangle3 = {Map[{#[[1]], #[[2]] + 
                  1, #[[3]]} &, {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, 
                z2, z3 + 8}, {z1 + 8, z2, 
                z3}}]};
ppp2[z_, p_, q_, r_, s_, t_, u_] := 
      Block[{z1, z2, z3}, z1 = z[[1]]; z2 = z[[2]]; z3 = z[[3]]; 
        Join[Table[{SurfaceColor[Hue[s], Hue[s], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle[[n]]]]}, {n, 1, 4}], 
          Table[{SurfaceColor[Hue[t], Hue[t], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle2[[n]]]]}, {n, 1, 1}], 
          Table[{SurfaceColor[Hue[u], Hue[u], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle3[[n]]]]}, {n, 1, 1}]]]

ss = -4; st = 6; x = {1, 1, 1, 1, 1, 1, 1, 1}; 
    de[y_] := If[y == 1, 1/6, 1]; 
    Show[Graphics3D[{Text[R1, {-1, 20, 12}], 
          Text[R2, {-1.5, 11, 12}], Text[R3, {-3.5, 6, 9}], 
          Text[R4, {-5, 0, 7}], Text[R5, {6, 27, 12}], 
          Text[R6, {15, 27, 12}], 
          Join[Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[1]]], 
                  de[1 - x[[1]]]] &, {{8 + ss, st, 
                  8}}], 
Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[2]]], 
                  de[1 - x[[2]]]] &, {{8 + ss, st, 
                  16}}], 
Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[3]]], 
                  de[1 - x[[3]]]] &, {{8 + ss, st, 
                  24}}], 
Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[4]]], 
                  de[1 - x[[4]]]] &, {{8 + ss, st, 32}}], 
            Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[5]]], 
                  de[1 - x[[5]]]] &, {{16 + ss, st, 
                  8}}], 
Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[6]]], 
                  de[1 - x[[6]]]] &, {{16 + ss, st, 
                  16}}], 
Map[
              ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[7]]], 
                  de[1 - x[[7]]]] &, {{16 + ss, st, 24}}], 
            Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[8]]], 
                  de[1 - x[[8]]]] &, {{16 + ss, st, 
                  32}}]]}], 
Boxed -> False, 
      LightSources -> {{{1, 0, 20}, RGBColor[1, 0, 0]}, {{1, 1, 20}, 
            RGBColor[0, 1, 0]}, {{0, 1, 20}, RGBColor[0, 0, 1]}}]

Example 5.   (1)   If you start with  and use R1, then you get.

(2)  After that if  you  use R5, then you get.

Mathematica calculation for the above graphics.

Clear[z1, z2, z3, pp2];
pointsofrectangle = {{{z1, z2, z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, 
            z3}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]], #[[2]], #[[3]] + 8} &, {{z1, z2, 
              z3}, {z1 + 8, z2, z3}, {z1 + 8, z2 + 1, z3}, {z1, z2 + 1, 
              z3}}], {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1, z2 + 1, 
            z3 + 8}, {z1, z2 + 1, z3}}, 
        Map[{#[[1]] + 2, #[[2]], #[[3]]} &, {{z1, z2, z3}, {z1, 
              z2, z3 + 8}, {z1, z2 + 1, z3 + 8}, {z1, z2 + 1, z3}}]}; 
    pointsofrectangle2 = {{{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, z2, 
            z3 + 8}, {z1 + 8, z2, z3}}};
pointsofrectangle3 = {Map[{#[[1]], #[[2]] + 
                  1, #[[3]]} &, {{z1, z2, z3}, {z1, z2, z3 + 8}, {z1 + 8, 
                z2, z3 + 8}, {z1 + 8, z2, 
                z3}}]};
ppp2[z_, p_, q_, r_, s_, t_, u_] := 
      Block[{z1, z2, z3}, z1 = z[[1]]; z2 = z[[2]]; z3 = z[[3]]; 
        Join[Table[{SurfaceColor[Hue[s], Hue[s], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle[[n]]]]}, {n, 1, 4}], 
          Table[{SurfaceColor[Hue[t], Hue[t], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle2[[n]]]]}, {n, 1, 1}], 
          Table[{SurfaceColor[Hue[u], Hue[u], 5], 
              Polygon[Map[Rotate3D[(#), p, q, r, {0, 0.5, 20}] &, 
                  pointsofrectangle3[[n]]]]}, {n, 1, 1}]]]

ura2[x_] := 
      Block[{de}, de[y_] := If[y == 1, 1/6, 1]; 
        Show[Graphics3D[
            Join[Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[1]]], 
                    de[1 - x[[1]]]] &, {{8, 0, 
                    8}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[2]]], 
                    de[1 - x[[2]]]] &, {{8, 0, 
                    16}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[3]]], 
                    de[1 - x[[3]]]] &, {{8, 0, 
                    24}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[4]]], 
                    de[1 - x[[4]]]] &, {{8, 0, 32}}], 
              Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[5]]], 
                    de[1 - x[[5]]]] &, {{16, 0, 
                    8}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[6]]], 
                    de[1 - x[[6]]]] &, {{16, 0, 
                    16}}], 
Map[
                ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[7]]], 
                    de[1 - x[[7]]]] &, {{16, 0, 24}}], 
              Map[ppp2[#, 0, 2*Pi/4, 0, 0.5, de[x[[8]]], 
                    de[1 - x[[8]]]] &, {{16, 0, 
                    32}}]]], 
Boxed -> False, 
          LightSources -> {{{1, 0, 20}, RGBColor[1, 0, 0]}, {{1, 1, 20}, 
                RGBColor[0, 1, 0]}, {{0, 1, 20}, 
                RGBColor[0, 0, 1]}}]]

ura2[{1, 1, 1, 1, 1, 1, 1, 1}]

Mathematica calculation to divide arangemant into mutually disjoint classes.

The following calculation shows that all the arrangement can be diviede into 25 subclasses

g[1][
          x_] := {{1 - x[[1, 2]], 1 - x[[1, 1]]}, {x[[2, 1]], 
            x[[2, 2]]}, {x[[3, 1]], x[[3, 2]]}, {x[[4, 1]], 
            x[[4, 2]]}};
g[2][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {1 - x[[2, 2]], 
            1 - x[[2, 1]]}, {x[[3, 1]], 
            x[[3, 2]]}, {x[[4, 1]], x[[4, 2]]}};
g[3][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[3, 2]], 
            1 - x[[3, 1]]}, {x[[4, 1]], x[[4, 2]]}};
g[4][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {x[[2, 1]], 
            x[[2, 2]]}, {x[[3, 1]], 
            x[[3, 2]]}, {1 - x[[4, 2]], 
            1 - x[[4, 1]]}};
g[5][
          x_] := {{1 - x[[4, 1]], x[[1, 2]]}, {1 - x[[3, 1]], 
            x[[2, 2]]}, {1 - x[[2, 1]], 
            x[[3, 2]]}, {1 - x[[1, 1]], x[[4, 2]]}};
g[6][
          x_] := {{x[[1, 1]], 1 - x[[4, 2]]}, {x[[2, 1]], 
            1 - x[[3, 2]]}, {x[[3, 1]], 
            1 - x[[2, 2]]}, {x[[4, 1]], 
            1 - x[[1, 2]]}};

findvertex[x_] := 
      Block[{a = x, b, s, t1, t2}, t1 = 1; t2 = 2; s = {a}; 
        While[t2 > t1, t1 = Length[s]; 
          b = Flatten[
              Table[g[n][s[[m]]], {m, 1, Length[s]}, {n, 1, 6}], 1]; 
          s = Union[s, b]; t2 = Length[s]]; s]

Clear[s, v];
v=Flatten[Table[(({{x1, x2}, {x3, x4}, {x5, x6}, {x7, x8}})),{x1, 0, 1},{x2, 0, 1},{x3, 0, 1},{x4, 0, 1},{x5, 0, 1},{x6, 0, 1},{x7, 0, 1},{x8, 0, 1}],7];
k = Length[v]; t = 1; 
    While[k > 0, a = v[[1]]; s[t] = findvertex[a]; Print[t]; Print[s[t]]; 
      v = Complement[v, s[t]]; k = Length[v]; t = t + 1]

Problem 3. If you start with   ,how many arrangements are there that you can get by using the five rotations.  You can use rotations as many times as you want.

Mathematica calculation.

showfigure24[s_] := 
      Block[{b}, b = Flatten[s]; 
        Show[Graphics[
            Evaluate[
Table[
                Table[{Hue[Part[b, (y + 2  x)]/6], 
                    Rectangle[{y - 0.45, -x - 0.45}, {y + 0.45, -x + 
                          0.45}]}, 
{y, 1, 2}], {x, 0, 
                  3}]]], AspectRatio -> Automatic, 
          Background -> Black]]

showfigure24[g24[5][(({{0, 0}, {1, 1}, {1, 1}, {1, 1}}))]]

Answer to problem 3.  It is not difficult to get all the 36 arrangements, but it needs some time to make a good table with these arrangements.  If you get a good table, then it will make it easier to make a beautiful graph with it.  The strategy is the same.  It is better to locate vertexes with fewer lines in the first and the last columns.

⋯⋯Graph (7)

Mathematica calculation for the answer.

saka24 = {{{1, 0}, {1, 0}, {1, 0}, {1, 0}}, {{1, 0}, {0, 1}, {0, 
              1}, {1, 0}}, {{0, 1}, {1, 0}, {1, 0}, {0, 1}}, {{0, 1}, {0, 
              1}, {0, 1}, {0, 1}}, {{0, 0}, {0, 0}, {0, 0}, {0, 0}}, {{0, 
              0}, {1, 1}, {1, 1}, {0, 0}}, {{1, 1}, {0, 0}, {0, 0}, {1, 
              1}}, {{1, 1}, {1, 1}, {1, 1}, {1, 1}}, {{1, 1}, {0, 0}, {0, 
              0}, {0, 0}}, {{1, 1}, {1, 1}, {1, 1}, {0, 0}}, {{0, 0}, {0, 
              0}, {0, 0}, {1, 1}}, {{0, 0}, {1, 1}, {1, 1}, {1, 1}}, {{0, 
              0}, {1, 1}, {0, 0}, {0, 0}}, {{0, 0}, {0, 0}, {1, 1}, {0, 
              0}}, {{1, 1}, {1, 1}, {0, 0}, {1, 1}}, {{1, 1}, {0, 0}, {1, 
              1}, {1, 1}}, {{1, 1}, {1, 0}, {1, 0}, {0, 0}}, {{1, 1}, {0, 
              1}, {0, 1}, {0, 0}}, {{0, 0}, {1, 0}, {1, 0}, {1, 1}}, {{0, 
              0}, {0, 1}, {0, 1}, {1, 1}}, {{1, 1}, {1, 1}, {0, 0}, {0, 
              0}}, {{1, 1}, {0, 0}, {1, 1}, {0, 0}}, {{0, 0}, {1, 1}, {0, 
              0}, {1, 1}}, {{0, 0}, {0, 0}, {1, 1}, {1, 1}}, {{1, 0}, {1, 
              1}, {0, 0}, {1, 0}}, {{1, 0}, {0, 0}, {1, 1}, {1, 0}}, {{0, 
              1}, {1, 1}, {0, 0}, {0, 1}}, {{0, 1}, {0, 0}, {1, 1}, {0, 
              1}}, {{0, 0}, {1, 0}, {1, 0}, {0, 0}}, {{0, 0}, {0, 1}, {0, 
              1}, {0, 0}}, {{1, 1}, {1, 0}, {1, 0}, {1, 1}}, {{1, 1}, {0, 
              1}, {0, 1}, {1, 1}}, {{1, 0}, {0, 0}, {0, 0}, {1, 0}}, {{1, 
              0}, {1, 1}, {1, 1}, {1, 0}}, {{0, 1}, {0, 0}, {0, 0}, {0, 
              1}}, {{0, 1}, {1, 1}, {1, 1}, {0, 1}}};

Show[
      Graphics[Evaluate[
          Table[Table[{Text[k + 4 (h - 1), {1.5 + 3  h, 0.7 - 5  k}], 
                Table[Table[{Hue[
                        Part[Flatten[
                              saka24[[k + 4 (h - 1)]]], (y + 
                                2  x)]/6], 
                      Rectangle[{y + 3  h - 0.45, -x - 5  k - 0.45}, {y + 
                            3  h + 0.45, -x - 5  k + 0.45}]}, {y, 1, 
                      2}], {x, 0, 3}]}, {k, 1, 4}], {h, 1, 9}]]], 
      AspectRatio -> Automatic, Background -> Black]

Problem 4. (1)  Can you make a beautiful graph using Graph (7)?  
(2) Can you find a Hamiltonian path?

Answer to problem 4 (1).  It is not difficult to make a beautiful graph using Graph (7).  It is better to locate vertexes with a lot of lines in the middle part of graph, and vertexes with fewer lines in the first column and the last columns.

⋯⋯Graph (8)

Mathematica calculation for the Graph (8).

g24[1][
          x_] := {{1 - x[[1, 2]], 1 - x[[1, 1]]}, {x[[2, 1]], 
            x[[2, 2]]}, {x[[3, 1]], x[[3, 2]]}, {x[[4, 1]], 
            x[[4, 2]]}};
g24[2][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {1 - x[[2, 2]], 
            1 - x[[2, 1]]}, {x[[3, 1]], 
            x[[3, 2]]}, {x[[4, 1]], x[[4, 2]]}};
g24[3][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {x[[2, 1]], 
            x[[2, 2]]}, {1 - x[[3, 2]], 
            1 - x[[3, 1]]}, {x[[4, 1]], x[[4, 2]]}};
g24[4][
          x_] := {{x[[1, 1]], x[[1, 2]]}, {x[[2, 1]], 
            x[[2, 2]]}, {x[[3, 1]], 
            x[[3, 2]]}, {1 - x[[4, 2]], 
            1 - x[[4, 1]]}};
g24[5][
          x_] := {{1 - x[[4, 1]], x[[1, 2]]}, {1 - x[[3, 1]], 
            x[[2, 2]]}, {1 - x[[2, 1]], 
            x[[3, 2]]}, {1 - x[[1, 1]], x[[4, 2]]}};
g24[6][
          x_] := {{x[[1, 1]], 1 - x[[4, 2]]}, {x[[2, 1]], 
            1 - x[[3, 2]]}, {x[[3, 1]], 
            1 - x[[2, 2]]}, {x[[4, 1]], 
            1 - x[[1, 2]]}};

firststep24[x_] := Table[g24[n][x], {n, 1, 6}];

The function mumb[x] returns the position of the arrangement in the list sakaguchi.

firststep24[{{0, 1}, {1, 1}, {1, 1}, {0, 1}}]

numb24[x_] := Position[saka24, x][[1, 1]];

numb24[{{0, 1}, {1, 1}, {1, 1}, {0, 1}}]

By using two functions firststep and numb we can make the list of lines that connect vertexes.

dd24 = 
      Flatten[Table[
          Map[{{n, numb24[#]}} &, firststep24[saka24[[n]]]], {n, 
            1.  Length[saka24]}], 1]

f[x_] := {{Min[x[[1, 1]], x[[1, 2]]], 
          Max[x[[1, 1]], x[[1, 2]]]}}

Length[dd24]

ddd24 = 
      Select[Union[Map[f, dd24]], #[[1, 1]] < #[[1, 2]] &]

<< DiscreteMath`Combinatorica`

ddd24 = {{{1, 5}}, {{1, 8}}, {{2, 6}}, {{2, 7}}, {{3, 6}}, {{3, 
              7}}, {{4, 5}}, {{4, 8}}, {{5, 9}}, {{5, 11}}, {{5, 13}}, {{5, 
              14}}, {{6, 10}}, {{6, 12}}, {{6, 13}}, {{6, 14}}, {{7, 
              9}}, {{7, 11}}, {{7, 15}}, {{7, 16}}, {{8, 10}}, {{8, 
              12}}, {{8, 15}}, {{8, 16}}, {{9, 17}}, {{9, 18}}, {{9, 
              21}}, {{9, 22}}, {{10, 17}}, {{10, 18}}, {{10, 21}}, {{10, 
              22}}, {{11, 19}}, {{11, 20}}, {{11, 23}}, {{11, 24}}, {{12, 
              19}}, {{12, 20}}, {{12, 23}}, {{12, 24}}, {{13, 21}}, {{13, 
              23}}, {{13, 25}}, {{13, 27}}, {{14, 22}}, {{14, 24}}, {{14, 
              26}}, {{14, 28}}, {{15, 21}}, {{15, 23}}, {{15, 25}}, {{15, 
              27}}, {{16, 22}}, {{16, 24}}, {{16, 26}}, {{16, 28}}, {{17, 
              29}}, {{17, 31}}, {{18, 30}}, {{18, 32}}, {{19, 29}}, {{19, 
              31}}, {{20, 30}}, {{20, 32}}, {{25, 33}}, {{25, 34}}, {{26, 
              33}}, {{26, 34}}, {{27, 35}}, {{27, 36}}, {{28, 35}}, {{28, 
              36}}, {{29, 33}}, {{29, 36}}, {{30, 34}}, {{30, 35}}, {{31, 
              34}}, {{31, 35}}, {{32, 33}}, {{32, 36}}};

G24 = 
        Graph[ddd24, {{{10, 32}}, {{10, 28}}, {{10, 24}}, {{10, 20}}, {{20, 
                32}}, {{20, 28}}, {{20, 24}}, {{20, 20}}, {{30, 48}}, {{30, 
                44}}, {{30, 40}}, {{30, 36}}, {{30, 16}}, {{30, 12}}, {{30, 
                8}}, {{30, 4}}, {{40, 48}}, {{40, 44}}, {{40, 40}}, {{40, 
                36}}, {{40, 32}}, {{40, 28}}, {{40, 24}}, {{40, 20}}, {{40, 
                16}}, {{40, 12}}, {{40, 8}}, {{40, 4}}, {{52, 48}}, {{54, 
                44}}, {{56, 40}}, {{58, 36}}, {{58, 16}}, {{56, 12}}, {{54, 
                8}}, {{52, 4}}}];

ShowGraph[
        SetGraphOptions[
          G24, {{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 
              18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 
              34, 35, 36, VertexColor -> Red}}, EdgeColor -> Blue, 
          Background -> Green], VertexNumber -> True];

Answer to problem 4 (2).  It is not easy to find a Hamiltonian path.  To tell you the truth it took Ryohei Miyadera who is one of the author of this article 6 hours to find a Hamiltonian path, but it was quite an experience and gave him a lot of joy when he found one.  Perhaps there are many people who are a lot better than he is in finding things.  If you can use a good software like Mathematica, it will take only a few minutes to find one. 
    One Hamiltonian path is {2,6,3,7,9,17,10,18,30,20,32,33,25,13,21,15,27,35,28,36,29,19,31,34,26,14,22,\
16,24,11,23,12,8,4,5,1}.  Once you have a answer, it will not be difficult to check the answer.

Mathematica calculation for a Hamiltonian path.

HamiltonianPath[g_Graph]  :=  HamiltonianPath[g,  One]
\(HamiltonianPath[g_Graph, \ 
        One]\  := \ 
\ \ \ \ \ \ \ \ Module[{c\  = \ HamiltonianCycle[g], \ 
          nonEdges, \ p, \ q}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[
          c\  != \ {}, \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Drop[
            c, \ \(-1\)], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ nonEdges\  = \ Complement[Flatten[
                Table[{i, \ j}, \ {i, \ V[g] - 1}, \ {j, \ i + 1, \ V[g]}], 
                1], \ Edges[g]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Do[
            h\  = \ AddEdges[g, \ 
                nonEdges[\([i]\)]]; \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[\((\((BiconnectedQ[
                      h])\)\  && \ \((\((c\  = \ 
                          HamiltonianCycle[
                            h])\)\  != \ {})\))\), 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ p\  = \ \(Position[c\  = \ Drop[c, \(-1\)], \ 
                    nonEdges[\([i, \ 1]\)]]\)[\([1, \ 
                    1]\)]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ c\  = \ RotateLeft[c, \ 
                  p - 1]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[nonEdges[\([i, \ 2]\)]\  == \ c[\([2]\)], \ 
                c\  = \ RotateLeft[c, \ 
                    1]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Break[]
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ {i, \ 
              Length[nonEdges]}
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ c
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]
\ \ \ \ \ \ \ \ ]\)

Timing[HamiltonianPath[G24]]

If you have Mathematica 5.2,  
    then you cannot use HamiltonianPath.

Ham[g_Graph]  :=  Ham[g,  One]
\(Ham[g_Graph, \ 
        One]\  := \ 
\ \ \ \ \ \ \ \ Module[{c\  = \ HamiltonianCycle[g], \ 
          nonEdges, \ p, \ q}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[
          c\  != \ {}, \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Drop[
            c, \ \(-1\)], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ nonEdges\  = \ Complement[Flatten[
                Table[{i, \ j}, \ {i, \ V[g] - 1}, \ {j, \ i + 1, \ V[g]}], 
                1], \ Edges[g]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Do[
            h\  = \ AddEdges[g, \ 
                nonEdges[\([i]\)]]; \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[\((\((BiconnectedQ[
                      h])\)\  && \ \((\((c\  = \ 
                          HamiltonianCycle[
                            h])\)\  != \ {})\))\), 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ p\  = \ \(Position[c\  = \ Drop[c, \(-1\)], \ 
                    nonEdges[\([i, \ 1]\)]]\)[\([1, \ 
                    1]\)]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ c\  = \ RotateLeft[c, \ 
                  p - 1]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[nonEdges[\([i, \ 2]\)]\  == \ c[\([2]\)], \ 
                c\  = \ RotateLeft[c, \ 
                    1]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Break[]
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ {i, \ 
              Length[nonEdges]}
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ c
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]
\ \ \ \ \ \ \ \ ]\)

Timing[Ham[G24]]

Timing[Ham[G24]]

By Pentium 4 2.8.

Remark.  We used Mathematica and the programs in S.Skiena and S. Pemmaraju  [1] to make graphs in this article.

References.

R .  Miyadera,  M .  Sakaguchi,  
      R .  Kawagoe and T .  Miura [1] Essays and Studies,  
      Kwansei Gakuin Senior High School 1991. 
T . 
        Takagi [1]  The back and front Puzzle,  
    Suurikagaku  5/1982. 
S . 
        Skiena and S .  Pemmaraju  [1] 
      Computational Discrete Mathematics : 
        Combinatorics and Graph Theory With Mathematica
Cambridge Univ Pr.